Data Wrangling - Final Project

1 Loading Library and Reading the Data

library(tidyverse)
library(readxl)
library(plotly)

CAP_FINAL <- read_excel("Downloads/Nutrition__Physical_Activity__and_Obesity_-_Behavioral_Risk_Factor_Surveillance_System.xlsx")

head(CAP_FINAL)

1.1 Filtering Questions, Ages, and Gender

All_Ages1 <- CAP_FINAL %>%
  filter(Question == "Percent of adults who engage in muscle-strengthening activities on 2 or more days a week") %>%
  filter(`Age(years)` %in% c("18 - 24", "25 - 34", "35 - 44"))
All_Ages1

1.2 Filtering Questions, Ages, and Gender

All_Gender1 <- CAP_FINAL %>%
  filter(Question == "Percent of adults who engage in muscle-strengthening activities on 2 or more days a week") %>%
  filter(`Gender` %in% c("Female", "Male"))
All_Gender1

1.3 Filtering Questions

Q <- CAP_FINAL %>%
  filter(Question %in% c("Percent of adults who engage in muscle-strengthening activities on 2 or more days a week", "Percent of adults who achieve at least 150 minutes a week of moderate-intensity aerobic physical activity or 75 minutes a week of vigorous-intensity aerobic activity (or an equivalent combination)", "Percent of adults who achieve at least 300 minutes a week of moderate-intensity aerobic physical activity or 150 minutes a week of vigorous-intensity aerobic activity (or an equivalent combination)", "Percent of adults who engage in no leisure-time physical activity"))
Q

1.4 Filtering Question 1 and Educational levels

Q1 <- CAP_FINAL %>%
  filter(Question == "Percent of adults who engage in muscle-strengthening activities on 2 or more days a week") %>%
  filter(`Education` %in% c("Less than high school", "High school graduate", "Some college or technical school", "College graduate"))
Q1

1.5 Filtering Question 2 and Educational levels

Q2 <- CAP_FINAL %>%
  filter(Question == "Percent of adults who achieve at least 150 minutes a week of moderate-intensity aerobic physical activity or 75 minutes a week of vigorous-intensity aerobic activity (or an equivalent combination)") %>%
  filter(`Education` %in% c("Less than high school", "High school graduate", "Some college or technical school", "College graduate"))
Q2

NA

1.6 Filtering Question 3 and Educational levels

Q3 <- CAP_FINAL %>%
  filter(Question == "Percent of adults who achieve at least 300 minutes a week of moderate-intensity aerobic physical activity or 150 minutes a week of vigorous-intensity aerobic activity (or an equivalent combination)") %>%
  filter(`Education` %in% c("Less than high school", "High school graduate", "Some college or technical school", "College graduate"))
Q3

1.7 Filtering Question 4 and Educational levels

Q4 <- CAP_FINAL %>%
  filter(Question == "Percent of adults who engage in no leisure-time physical activity") %>%
  filter(`Education` %in% c("Less than high school", "High school graduate", "Some college or technical school", "College graduate"))
Q4

2 Comparing each Question, Percentage (Data Value), and Sample Size

ggplot(Q, aes(x= str_wrap(`Question`, width = 10), y=`Data_Value`, fill = `Sample_Size`)) + 
  geom_bar(stat = "identity") +  theme(legend.position="right") +
  xlab("Question") + ylab("Percentage") + ggtitle("Comparing All Educational Levels, Percentage, and Sample Size")

              
ggplotly(tooltip = c("y", "fill"))

Removed 29 rows containing missing values (position_stack).

2.1 Comparing Question 1, Educational Levels, Percentage (Data Value), and Sample Size

ggplot(Q1, aes(x= str_wrap(`Education`, width = 10), y=`Data_Value`, fill = `Sample_Size`)) + 
  geom_bar(stat = "identity") +  theme(legend.position="right") +
  xlab("Education") + ylab("Percentage") + ggtitle("Comparing Educational Levels, Percentage, and Sample Size")

              
ggplotly(tooltip = c("y", "fill"))

2.1.1 Comparing Question 1, Educational Levels, Percentage (Data Value), and Sample Size

ggplot(All_Gender1, aes(x= `Sample_Size`, y=`Data_Value`, fill = `Question`)) + 
  geom_bar(stat = "identity") +  theme(legend.position="top",
              axis.text = element_text(angle = 10, vjust = 0.6)) +
  xlab("Sample Size") + ylab("Percentage") + ggtitle("Percent of adults who engage in muscle-strengthening activities")

ggplotly()

2.2 Comparing Question 2, Educational Levels, Percentage (Data Value), and Sample Size

ggplot(Q2, aes(x= str_wrap(`Education`, width = 10), y=`Data_Value`, fill = `Sample_Size`)) + 
  geom_bar(stat = "identity") +  theme(legend.position="right") +
  xlab("Education") + ylab("Percentage") + ggtitle("Comparing Educational Levels, Percentage, and Sample Size")

              
ggplotly(tooltip = c("y", "fill"))

2.3 Comparing Question 3, Educational Levels, Percentage (Data Value), and Sample Size

ggplot(Q3, aes(x= str_wrap(`Education`, width = 10), y=`Data_Value`, fill = `Sample_Size`)) + 
  geom_bar(stat = "identity") +  theme(legend.position="right") +
  xlab("Education") + ylab("Percentage") + ggtitle("Comparing Educational Levels, Percentage, and Sample Size")

              
ggplotly(tooltip = c("y", "fill"))

2.4 Comparing Question 4, Educational Levels, Percentage (Data Value), and Sample Size

ggplot(Q4, aes(x= str_wrap(`Education`, width = 10), y=`Data_Value`, fill = `Sample_Size`)) + 
  geom_bar(stat = "identity") +  theme(legend.position="right") +
  xlab("Education") + ylab("Percentage") + ggtitle("Comparing Educational Levels, Percentage, and Sample Size")

              
ggplotly(tooltip = c("y", "fill"))

3 Combining Aggregared Data

3.1 All Ages

All_Ages <- CAP_FINAL %>% 
  filter(`Age(years)` %in% c("18 - 24", "25 - 34", "35 - 44", "45 - 54", "55 - 64", "65 or older"))
head(All_Ages)

3.2 All Education

All_Edu <- CAP_FINAL %>%
  filter(`Education` %in% c("Less than high school", "High school graduate", "Some college or technical school", "College graduate"))
head(All_Edu)

3.3 All Gender

All_Gender <- CAP_FINAL %>%
  filter(`Gender` %in% c("Female", "Male"))
head(All_Gender)

3.4 All Income

All_Income <- CAP_FINAL %>%
  filter(`Income` %in% c("Less than $15,000", "$15,000 - $24,999", "$25,000 - $34,999", "$35,000 - $49,999", "$50,000 - $74,999", "$75,000 or greater"))
head(All_Income)

3.5 All Race/Ethnicity

All_Races <- CAP_FINAL %>%
  filter(`Race/Ethnicity` %in% c("American Indian/Alaska Native", "Asian", "Hawaiian/Pacific Islander", "Non-Hispanic Black", "Non-Hispanic White", "Hispanic", "2 or more races"))
head(All_Races)

3.6 Age 18-24

Age <- CAP_FINAL %>%
  filter(`Age(years)` %in% "18 - 24")
head(Age)

4 Visualization for All Ages

4.1 Boxplot for All Ages

ggplot(data = All_Ages, 
       aes(x=reorder(`Age(years)`, `Data_Value`), y=`Data_Value`, fill=`Sample_Size`, color = "Age(years)")) + 
  geom_boxplot() + xlab("Age(years)") + ylab("Percentage") +
  theme(legend.position="top") + ggtitle("Boxplot for All Ages")

ggplotly()

4.2 All Ages and Sample Size

j1 <- ggplot(data = All_Ages, 
  aes(x = `Age(years)`, y = Data_Value, color = `Sample_Size`)) +
  geom_point(stat = "Identity", fill = "#532d8e") + 
  xlab("Age(years)") + ylab("Percentage") + ggtitle("Comparing All Ages and Sample Size")
j1

ggplotly(j1)

5 Data Analysis and Visualization

5.1 Comparing Income, Data Value, and Sample Size

j3 <- ggplot(All_Income,
             aes(x = Income,
                 y = Sample_Size)) + 
        theme(legend.position="right",
              axis.text = element_text(angle = 20, vjust = 0.6))
(j4 <- j3 + geom_point(aes(color = Data_Value),
                       alpha = 0.5,
                       size = 1.5,
                       position = position_jitter(width = 0.25, height = 0)))

j4 +
  scale_x_discrete(name="Income") +
  scale_color_continuous(name="",
                         breaks = c(10, 40, 60),
                         labels = c("10", "40", "60"),
                         low = "blue", high = "red") +      ggtitle("Comparing Income and Sample Size")

ggplotly()

5.2 Comparing Gender, Data value, and Sample Size

j2 <- ggplot(All_Gender,
             aes(x = Gender,
                 y = Sample_Size)) + 
        theme(legend.position="right",
              axis.text = element_text(angle = 20, vjust = 0.6))
(j2a <- j2 + geom_point(aes(color = Data_Value),
                       alpha = 0.5,
                       size = 1.5,
                       position = position_jitter(width = 0.25, height = 0)))

j2a +
  scale_x_discrete(name="Gender") +
  scale_color_continuous(name="",
                         breaks = c(10, 40, 60),
                         labels = c("10", "40", "60"),
                         low = "blue", high = "red") +      ggtitle("Comparing Gender and Sample Size")

ggplotly()

include for young adults 18-44

5.3 Comparing Race/Ethnicity, Data Value, and Sample Size

j5 <- ggplot(All_Races,
             aes(x = `Race/Ethnicity`,
                 y = Sample_Size)) + 
        theme(legend.position="right",
              axis.text = element_text(angle = 20, vjust = 0.6))
(j5a <- j5 + geom_point(aes(color = Data_Value),
                       alpha = 0.5,
                       size = 1.5,
                       position = position_jitter(width = 0.25, height = 0)))

j5a +
  scale_x_discrete(name="Race/Ethnicity") +
  scale_color_continuous(name="",
                         breaks = c(10, 40, 60),
                         labels = c("10", "40", "60"),
                         low = "blue", high = "red") +      ggtitle("Comparing Race/Ethnicity and Sample Size")

ggplotly()

NA

5.4 Comparing Education, Data Value, and Sample Size

j6 <- ggplot(All_Edu,
             aes(x = `Education`,
                 y = Sample_Size)) + 
        theme(legend.position="right",
              axis.text = element_text(angle = 20, vjust = 0.6))
(j6a <- j6 + geom_point(aes(color = Data_Value),
                       alpha = 0.5,
                       size = 1.5,
                       position = position_jitter(width = 0.25, height = 0)))

j6a +
  scale_x_discrete(name="Education") +
  scale_color_continuous(name="",
                         breaks = c(10, 40, 60),
                         labels = c("10", "40", "60"),
                         low = "blue", high = "red") +      ggtitle("Comparing Education and Sample Size")

ggplotly()

NA

5.5 Focusing on Young Adults Age 18 - 44

j1 <- ggplot(filter(All_Ages, `Age(years)` %in% c("18 - 24", "25 - 34", "35 - 44")), aes(x = `Age(years)`,
                 y = Sample_Size)) + 
        theme(legend.position="right",
              axis.text = element_text(angle = 20, vjust = 0.6)) 
(j1a <- j1 + geom_point(aes(color = Data_Value),
                       alpha = 0.5,
                       size = 1.5,
                       position = position_jitter(width = 0.25, height = 0)))

j1a +
  scale_x_discrete(name="Age(years)") +
  scale_color_continuous(name="",
                         breaks = c(10, 40, 60),
                         labels = c("10", "40", "60"),
                         low = "blue", high = "red") +      ggtitle("Comparing Young Adults (18-44) and Sample Size")

ggplotly()

5.6 Focusing on Young Adults Age 18 - 44

j1 <- ggplot(filter(All_Ages, `Age(years)` %in% c("18 - 24", "25 - 34", "35 - 44")), aes(x = `Age(years)`,
                 y = Data_Value)) + 
        theme(legend.position="right",
              axis.text = element_text(angle = 20, vjust = 0.6)) 
(j1a <- j1 + geom_point(aes(color = Sample_Size),
                       alpha = 0.5,
                       size = 1.5,
                       position = position_jitter(width = 0.25, height = 0)))

j1a +
  scale_x_discrete(name="Age(years)") +
  scale_color_continuous(name="",
                         breaks = c(10, 40, 60),
                         labels = c("10", "40", "60"),
                         low = "blue", high = "red") +      ggtitle("Comparing Percentage and Young Adult (18-44)")

ggplotly()